home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fsimple.for < prev    next >
Text File  |  1991-06-03  |  2KB  |  136 lines
  1.     program fsimple
  2.  
  3. $INCLUDE: 'fvogl.h'
  4. $INCLUDE: 'fvodevic.h'
  5.  
  6. c  A program showing basic line drawing, text and (if applicable)
  7. c  colour. As none of the projection routines have been called we
  8. c  move and draw in the initial coordinate system -1.0 to 1.0.
  9. c
  10.     character fname*80, p*11
  11.     logical sfont
  12.     integer*2 val
  13.     data p/'Hello world'/
  14.  
  15.     
  16.     print*,'Use (h)ardware font or (H)ershey font?'
  17.     read(*,'(a)') fname
  18.  
  19.     sfont = fname(1:1) .eq. 'H'
  20.     
  21.     if (sfont) then
  22.         print*,'Enter a Hershey font name:'
  23.         read(*,'(a)') fname
  24.     end if
  25.     
  26. c
  27. c  set up device 
  28. c
  29.     call winope('simple', 6)
  30. c
  31. c  We want to exit after a keyboard press.
  32. c
  33.     call unqdev(INPUTC)
  34.     call qdevic(KEYBD)
  35. c
  36. c  We want our coordinates to go from -1 to 1 in x and y
  37. c
  38.     call ortho2(-1.0, 1.0, -1.0, 1.0)
  39. c
  40. c  change font to the one input...and set textsize
  41. c
  42.     if (sfont) then
  43.         call hfont(fname, nchars(fname))
  44.         call htexts(0.05, 0.05)
  45.     end if
  46. c
  47. c  set current color
  48. c
  49.     call color(BLACK)
  50. c
  51. c  clear screen to current color 
  52. c
  53.     call clear
  54. c
  55. c
  56.     call color(GREEN)
  57. c
  58. c  2 d move to start where we want to draw a string start 
  59. c  Uses cmov2 for 'hardware' font or move2 for software font
  60. c  then draws string in current color 
  61. c
  62.     if (sfont) then
  63.         call move2(-0.9, 0.9)
  64.         call hchars('A Simple Example', 16)
  65.     else
  66.         call cmov2(-0.9, 0.9)
  67.         call charst('A Simple Example', 16)
  68.     end if
  69. c
  70. c
  71. c  the next four lines draw the x 
  72. c
  73.     call move2(0.0, 0.0)
  74.     call draw2(0.76, 0.76)
  75.     call move2(0.0, 0.76)
  76.     call draw2(0.76, 0.0)
  77.  
  78. c
  79. c  Now some more text...
  80. c
  81.     if (sfont) then
  82.         call move2(0.0, 0.5)
  83.         call hchars('x done', 6)
  84.         call hchars('next sentence', 13)
  85.         call move2(0.0, 0.1)
  86.         do 10 i = 1, 11
  87.             call hdrawc(p(i:i))
  88. 10        continue
  89.     else
  90.         call cmov2(0.0, 0.5)
  91.         call charst('x done', 6)
  92.         call charst('next sentence', 13)
  93.         call cmov2(0.0, 0.1)
  94.         do 20 i = 1, 11
  95.             call charst(p(i:i), 1)
  96. 20        continue
  97.     end if
  98.  
  99. c 
  100. c  the next five lines draw the square
  101. c
  102.     call move2(0.0, 0.0)
  103.     call draw2(0.76, 0.0)
  104.     call draw2(0.76, 0.76)
  105.     call draw2(0.0, 0.76)
  106.     call draw2(0.0, 0.0)
  107. c
  108. c  wait for some input 
  109. c
  110.     idum = qread(val)
  111. c
  112. c  set the screen back to its original state 
  113. c
  114.     call gexit
  115.     end
  116. c
  117. c nchars
  118. c
  119. c return the real length of a string padded with blanks
  120. c
  121.     integer function nchars(str)
  122.     character *(*) str
  123.  
  124.     do 10 i = len(str), 1, -1
  125.         if (str(i:i) .ne. ' ') then
  126.             nchars = i
  127.             return
  128.         end if
  129. 10      continue
  130.  
  131.     nchars = 0
  132.  
  133.     return
  134.  
  135.     end
  136.